home *** CD-ROM | disk | FTP | other *** search
/ MacHack 2001 / MacHack 2001.toast / pc / The Hacks / 99 Bottles hack / MyUtils / MyMemory.p < prev    next >
Encoding:
Text File  |  2001-06-23  |  2.9 KB  |  142 lines
  1. unit MyMemory;
  2.  
  3. { Memory manager functions }
  4.  
  5. interface
  6.  
  7. {$IFC MACTARGET}
  8.     uses
  9.         Types, Memory;
  10. {$ENDC}
  11.  
  12. {$IFC WINTARGET}
  13.     uses
  14.         MyWinUtils;
  15. {$ENDC}
  16.     
  17. { Mod. PhC 31/05/01: Les Handle ne sont disponibles que sur le Mac. }
  18. {$IFC MACTARGET}
  19.     function MyNewHandle(logicalSize: LongInt): Handle;
  20. {$ENDC}
  21.  
  22. {$IFC WINTARGET}
  23.  
  24.     function NewPtrClear(logicalSize: LongInt): Ptr;
  25. {$IFC DLLTARGET}
  26.     DLLEXPORT;
  27. {$ENDC}
  28.     
  29.     procedure DisposePtr(p: univ Ptr);
  30. {$IFC DLLTARGET}
  31.     DLLEXPORT;
  32. {$ENDC}
  33.     
  34.     procedure SetPtrSize(var p: univ Ptr; logicalSize: LongInt);
  35. {$IFC DLLTARGET}
  36.     DLLEXPORT;
  37. {$ENDC}
  38.  
  39.     function GetPtrSize(p: univ Ptr): LongInt;
  40. {$IFC DLLTARGET}
  41.     DLLEXPORT;
  42. {$ENDC}
  43.     
  44.     function MemError: OSErr;
  45. {$IFC DLLTARGET}
  46.     DLLEXPORT;
  47. {$ENDC}
  48.     
  49.     procedure BlockMoveData(source: univ Ptr; dest: univ Ptr; nb: LongInt);
  50. {$IFC DLLTARGET}
  51.     DLLEXPORT;
  52. {$ENDC}
  53.  
  54. {$ENDC}
  55.  
  56. implementation
  57.  
  58. {$IFC MACTARGET}
  59.     function MyNewHandle(logicalSize: LongInt): Handle;
  60.  
  61. { Mod. PhC 20/07/00: }
  62. { J'ai rajouté une vérification de la taille de mémoire disponible avec MaxBlock }
  63. { car NewHandle plantait quelquefois si logicalSize était trop gros, i.e. le programme }
  64. { gelait au lieu de continuer avec h = nil. L'appel à la mémoire temporaire fonctionne }
  65. { bien maintenant. J'ai aussi remplacé NewHandleClear par NewHandle vu qu'il n'existe pas }
  66. { de TempNewHandleClear, et j'ai vérifié que mon code ne dépend plus que le handle soit }
  67. { 'clear', ou rempli de zéros. Cela est effectué manuellement lorsque nécessaire. }
  68.     var
  69.         h: Handle;
  70.         resultCode: OSErr;
  71.         max: LongInt;
  72.  
  73.     begin
  74.         max := MaxBlock;
  75.         h := nil;
  76.         if (logicalSize < max) then
  77.             h := NewHandle(logicalSize);
  78.     { Utiliser la mémoire temporaire si l'appel à NewHandle n'a }
  79.     { pas fonctionné }
  80.         if (h = nil) then 
  81.             h := TempNewHandle(logicalSize, resultCode);
  82.         MyNewHandle := h;
  83.     end; { MyNewHandle }
  84. {$ENDC}
  85.  
  86. {$IFC WINTARGET}
  87.     function NewPtrClear(logicalSize: LongInt): Ptr;
  88.     begin
  89.         NewPtrClear := Ptr(HeapAlloc(GetProcessHeap, HEAP_ZERO_MEMORY, logicalSize));
  90.     end;
  91.     
  92.     procedure DisposePtr;
  93.     var
  94.         b: Bool;
  95.     begin
  96.         b := HeapFree(GetProcessHeap, 0, LPVOID(p));
  97. {
  98.         IF b <> 0 THEN
  99.             DisposePtr := mNoErr
  100.         ELSE
  101.             DisposePtr := GetLastError;
  102. }
  103.     end;
  104.  
  105.     procedure SetPtrSize(var p: univ Ptr; logicalSize: LongInt);
  106.     var
  107.         newP: Ptr;
  108.     begin
  109.         if (p <> nil) then begin
  110.             newP := Ptr(HeapReAlloc(GetProcessHeap, 0, LPVOID(p), logicalSize));
  111.             p := newP;
  112.         end;
  113.     end;
  114.  
  115.     function GetPtrSize(p: univ Ptr): LongInt;
  116.     begin
  117.         if (p = nil) then
  118.             GetPtrSize := 0
  119.         else
  120.             GetPtrSize := HeapSize(GetProcessHeap, 0, LPVOID(p));
  121.     end;
  122.     
  123.     procedure BlockMoveData(source: univ Ptr; dest: univ Ptr; nb: LongInt);
  124.     type
  125.         TBuffer = packed array[1..30000] of Char;
  126.         TBufferPtr = ^TBuffer;
  127.     var
  128.         i: LongInt;
  129.     begin
  130.         for i := 1 to nb do
  131.             TBufferPtr(dest)^[i] := TBufferPtr(source)^[i];
  132.         { should use CopyMemory(dest, source, nb); but it has problems}
  133.     end;
  134.  
  135.     function MemError;
  136.     begin
  137.         MemError := GetLastError;
  138.     end;
  139.         
  140. {$ENDC}
  141.  
  142. end. { MyMemory }